Attribute VB_Name = "Module1"
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_NORMAL = 1


'download records each time
Public Const DOWN_RECORDS As Integer = 150
Public CustomerType As Integer

Public Const INIT_STATUS As Integer = 0
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const CHECK_DATA As Integer = 1
Public Const FIND_CUSTOMER As Integer = 2
Public Const NEW_CUSTOMER As Integer = 3
Public Const NEW_CUS_YP As Integer = 4
Public Const SEARCH_HISTORY As Integer = 5

Public Const SOFT_TITLE As String = "Oversea Management"

Public Operator As String
Public Operator_ACC As Long
Public Operator_ID As Integer
Public Operator_City As Integer

Public Const NUMBER_USERS As Integer = 20
Public Const MAX_BUGS As Integer = 1000

Public Const MAX_RET_ITEMS As Integer = 1000
Public Const SUB_CLASS As Integer = 1000

Public Const MAX_URL_ONE_PAGE As Integer = 15000

Public Const DB_IP As String = "cat193.redphp.cn"
Const DB_USER As String = "u117111"
Const DB_PWD As String = "4YvHLid5"
Const DB_NAME As String = "u117111_oversea"
Const DB_CONT As String = "u117111_phoebe"

'------------for localhost-----------------
'Public Const DB_IP As String = "localhost"
'Const DB_USER As String = "root"
'Const DB_PWD As String = ""
'Const DB_NAME As String = "oversea_cslibary"
'Const DB_CONT As String = "oversea_phoebe"



'connection type, for retry purpose
'1 : connect to oversea
'2: connect to software database
'3: news database
'default to oversea
Private iTypeConnect As Integer

'for second level sort id
Public iSecond_Sort As Long
'File system
'--------------------------------
Const BACKUP_FOLDER As String = "./"

Public Type YellowPage
    URL As String
    name As String
    SLOGAN As String
    ADDRESS As String
    email As String
    tel As String
    website As String
    des As String
    logo As String
    BRAND_P As String
    HRS As String
    fax As String
    
    city As Integer
    Second_Sort  As Long
    first_sort As Long
End Type
Public yp As YellowPage

'----------------------------------
'Check customers data
Public CheckCity As Integer
Public CheckCatalog As Integer

'----------------------------------
'connect to software database
Public Function Cn2SQL(cn As ADODB.Connection)
    CustomerType = INIT_STATUS
    iTypeConnect = 2
    On Error GoTo NextConnection
    cn.Open "driver={MySql ODBC 3.51 Driver};server=" & DB_IP & ";uid=" & DB_USER & ";pwd=" & DB_PWD & ";database=" & DB_CONT & "; Stmt=Set Names 'GBK'"
    Exit Function
NextConnection:
    cn.Open "driver={MySql ODBC 5.1 Driver};server=" & DB_IP & ";uid=" & DB_USER & ";pwd=" & DB_PWD & ";database=" & DB_CONT & "; Stmt=Set Names 'GBK'"
End Function

'connect to oversea system database
Public Function Cn2System(cn As ADODB.Connection)
    On Error GoTo NextConnection
    cn.Open "driver={MySql ODBC 3.51 Driver};server=" & DB_IP & ";uid=" & DB_USER & ";pwd=" & DB_PWD & ";database=information_schema; Stmt=Set Names 'GBK'"
    Exit Function
NextConnection:
    cn.Open "driver={MySql ODBC 5.1 Driver};server=" & DB_IP & ";uid=" & DB_USER & ";pwd=" & DB_PWD & ";database=information_schema; Stmt=Set Names 'GBK'"
End Function


'connect to news database
Public Function Cn2News(cn As ADODB.Connection)
    Call Cn2Oversea(cn)
End Function

'connect to oversea database
Public Function Cn2Oversea(cn As ADODB.Connection)
    iTypeConnect = 1
    On Error GoTo NextConnection
    cn.Open "driver={MySql ODBC 3.51 Driver};server=" & DB_IP & ";uid=" & DB_USER & ";pwd=" & DB_PWD & ";database=" & DB_NAME & "; Stmt=Set Names 'GBK'"
    Exit Function
NextConnection:
    cn.Open "driver={MySql ODBC 5.1 Driver};server=" & DB_IP & ";uid=" & DB_USER & ";pwd=" & DB_PWD & ";database=" & DB_NAME & "; Stmt=Set Names 'GBK'"
End Function



Public Function OperateDatabase(ByRef rs As ADODB.Recordset, ByVal cn As ADODB.Connection, ByVal sql As String)
    On Error GoTo Retry
    rs.Open sql, cn, adOpenStatic, adLockBatchOptimistic
    'Debug.Print sql
    'Debug.Print cn
    Exit Function
Retry:
    If vbOK = MsgBox("Retry connect to database?", vbOKCancel, SOFT_TITLE) Then
        Call Try2CloseCn(cn)
        Select Case (iTypeConnect)
            Case 1:
                Call Cn2Oversea(cn)
            Case 2:
                Call Cn2SQL(cn)
            Case 3:
                Call Cn2News(cn)
        End Select
        DoEvents
        OperateDatabase rs, cn, sql
    Else
        End
    End If
End Function

Public Sub Try2CloseCn(ByRef cn As ADODB.Connection)
    On Error GoTo go
    cn.Close
go:
End Sub

Public Sub Main()
    iTypeConnect = 1
    Operator_ACC = 0
    frmSplash.Show
    DoEvents
    frmLogin.Show
    DoEvents
    Unload frmSplash
End Sub

Public Function AddSlashes(ByVal str As String) As String
Dim strCvt As String
Dim strLen, i As Integer
Dim ch As String
strLen = Len(str)
strCvt = ""
For i = 1 To strLen
    ch = Mid(str, i, 1)
    If ch = "'" Then
        strCvt = strCvt & "\" & ch
    Else
        strCvt = strCvt & ch
    End If
Next i

AddSlashes = strCvt
End Function

'expand id to the len to n which given in the parameter
Public Function formatn(id As String, n As Integer)
    Dim full_id As String
    Dim nid As Integer
    full_id = id
    nid = Len(full_id)
    While nid < n
        full_id = "0" & full_id
        nid = nid + 1
    Wend
    formatn = full_id
End Function




Public Function GetWebHTML(ByVal sWeb As String) As String
    Dim X As XMLHTTP
    On Error Resume Next
    URL = sWeb
    Set X = New XMLHTTP
    X.Open "GET", URL, False
    X.send
    GetWebHTML = X.responseText
    
    'Sleep 2000
    DoEvents
End Function


'Save a string to filesystem
Public Sub Save2File(ByVal Str2Save As String, ByVal FileName As String)
    Open BACKUP_FOLDER & FileName For Append As #2
    Print #2, Str2Save
    Close #2
End Sub




Public Sub FileToUTF8(FileName As String)
    'If GetEncoding(FileName) = UTF8 Then
       ' Exit Sub
    'End If
    
    Dim fBytes() As Byte, uniString As String, freeNum As Integer
    Dim ADO_Stream As Object
    
    freeNum = FreeFile
    
    ReDim fBytes(FileLen(FileName))
    Open FileName For Binary Access Read As #freeNum
        Get #freeNum, , fBytes
    Close #freeNum
    
    uniString = StrConv(fBytes, UTF8)
    
    Set ADO_Stream = CreateObject("ADODB.Stream")
    With ADO_Stream
        .Type = 2
        .Mode = 3
        .Charset = "UTF-8"
        .Open
        .WriteText uniString
        .SaveToFile FileName, 2
        .Close
    End With
    Set ADO_Stream = Nothing
End Sub

Public Sub DeleteRData(ByVal str As String)
    Dim fso As New Scripting.FileSystemObject
    FileName = "redundent.sql"
    If Not fso.FileExists(FileName) Then
        Set txtfile = fso.CreateTextFile(FileName, True)
    Else
        Set txtfile = fso.OpenTextFile(FileName, ForAppending, False)
    End If
    txtfile.WriteLine (str & ";")
    txtfile.Close
End Sub

Public Sub Save2UpdateLog(ByVal str As String)
    Dim fso As New Scripting.FileSystemObject
    FileName = "update.sql"
    If Not fso.FileExists(FileName) Then
        Set txtfile = fso.CreateTextFile(FileName, True)
    Else
        Set txtfile = fso.OpenTextFile(FileName, ForAppending, False)
    End If
    txtfile.WriteLine (str & ";")
    txtfile.Close
End Sub

Public Sub Save2OpLog(ByVal str As String)
    Dim fso As New Scripting.FileSystemObject
    FileName = "op.sql"
    If Not fso.FileExists(FileName) Then
        Set txtfile = fso.CreateTextFile(FileName, True)
    Else
        Set txtfile = fso.OpenTextFile(FileName, ForAppending, False)
    End If
    txtfile.WriteLine (str & ";")
    txtfile.Close
End Sub
